home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 15 / CU Amiga Magazine's Super CD-ROM 15 (1997)(EMAP Images)(GB)[!][issue 1997-10].iso / CUCD / Utilities / MathScript / MSExtras / StripCode / StripCode.ms < prev   
Encoding:
Text File  |  1997-02-01  |  6.1 KB  |  254 lines
  1. /*
  2.  
  3. StripCode 1.1 (for MathScript 3.1)
  4.  
  5. Remove formatting code from around the part
  6. of the formula under the cursor.
  7.  
  8. e.g. (where | represents the cursor)
  9.  
  10. (a+b|)+c   ->  a+b+c
  11. (a+|(b+c)) ->  a+(b+c)
  12. (a+(|b+c)) ->  (a+b+c)
  13.  
  14.  
  15. Removes the following codes:
  16.  
  17. ^<obj>
  18. _<obj>
  19. \ul<obj>
  20. \ol<obj>
  21. \l<b><obj>
  22. <obj>\r<b>
  23. \sqrt<obj>
  24.  
  25. \rt<obj1><obj2>  Note:  Will only remove the <obj1> part, and only if
  26.                         the cursor is within the <obj1> part.  The code
  27.                         will then be changed to <obj1>\sqrt<obj2>.
  28.                         
  29. \dt<n><obj>
  30. \not<obj>
  31. \atilde<obj>
  32. \aacute<obj>
  33. \agrave<obj>
  34. \ahat<obj>
  35. \abreve<obj>
  36. \acheck<obj>
  37. \lvec<obj>
  38. \rvec<obj>
  39. \bvec<obj>
  40.  
  41. <obj>\up\sy<x>   Note:  Will only work correctly if x is a single character.
  42.                         For codes inserted via the GUI, this will always
  43.                         be true (single dot, double dot etc.)
  44.  
  45.  
  46. Version History:
  47.  
  48. 0.1ß 10.08.96 Proof of concept
  49. 0.2ß 11.08.96 More codes detected.  Drag selection now allowable
  50. 0.3ß 15.08.96 Workaround for Null Pointer problem
  51. 0.4ß 16.08.96 Removed unnecessary SetCode/GetCode pair
  52. 0.5ß 28.08.96 Workaround for NewLine problem.  Removed false detection 
  53.               of _<obj> when the ^_<obj> code was used.  Added a partial
  54.               solution for removal of \rt code.
  55. 0.6ß 19.09.96 Workarounds for Null Pointer and NewLine removed thanks to
  56.               bugfixes in MathScript beta 4
  57. 0.7ß 12.10.96 More codes added.
  58. 1.0  27.10.96 First Public Release
  59. 1.1  02.02.97 Second Public Release
  60.               Added new codes from MathScript 3.1
  61.  
  62.  
  63. Chris Coulson (c.j.coulson@ncl.ac.uk)
  64.  
  65. */
  66.  
  67. options results
  68.  
  69. GetCode
  70. fml = result
  71. cp = CursorPos(fml)
  72. fml = StripCode(fml,cp)
  73. SetCode '"'fml'"'
  74. EXIT
  75.  
  76.  
  77.  
  78. /*
  79. CursorPos
  80.  
  81. Since there isn't a command to do this within
  82. Mathscript, we'll emulate it by writing a ! into 
  83. the formula at the cursor position, using InsertCode, 
  84. and then we'll use the ARexx Compare() function to 
  85. find where the ! was inserted.  Note that this
  86. method allows for drag-selection of the formula
  87. section to be stripped, unlike the earlier and less
  88. efficient method.  Two advantages for the price of one!
  89. */
  90.  
  91. CursorPos: PROCEDURE
  92. PARSE ARG OrgFml
  93. InsertCode '!'
  94. GetCode
  95. CPFml = result
  96. pos = COMPARE(OrgFml,CPFml)
  97. RETURN pos
  98.  
  99.  
  100. /*
  101. StripCode
  102.  
  103. Scan left and right from the cursor pos looking for
  104. the format code locations, then remove them.
  105. */
  106.  
  107. StripCode: PROCEDURE
  108. PARSE ARG fml, cp
  109. lcp = cp-1
  110. rcp = cp
  111. fml_len = LENGTH(fml)
  112. leave=0
  113. found=0
  114. lnest=0
  115. rnest=0
  116.  
  117. /*
  118. Look for the [ and ] characters by moving left and right from
  119. the starting cursor pos.  If a ] is found whilst moving left,
  120. or a [ is found whilst moving right, this indicates there is
  121. another formula code within the one we want to remove, and we
  122. need to bear this in mind when deciding whether any [ or ]
  123. found belong to the code we want to remove or not.  The lnest
  124. and rnest variables take care of this.  Each is decremented
  125. when a [ or ] is found, and incremented when a ] or [ is found.
  126. When one reaches -1, further scanning in that direction ceases.
  127. When both reach -1, we know we have found the correct [ and ]
  128. for our code.  
  129. */
  130.  
  131. DO UNTIL leave=1
  132.     IF (lcp > 0)&(lnest > -1) THEN
  133.     DO
  134.         lchar = SUBSTR(fml,lcp,1)
  135.         IF lchar = ']' THEN lnest = lnest + 1
  136.         IF lchar = '[' THEN
  137.         DO
  138.             lnest = lnest - 1
  139.             IF lnest = -1 THEN lpos = lcp
  140.         END
  141.         lcp = lcp - 1
  142.     END
  143.     IF (rcp < fml_len+1)&(rnest > -1) THEN
  144.     DO
  145.         rchar = SUBSTR(fml,rcp,1)
  146.         IF rchar = '[' THEN rnest = rnest + 1
  147.         IF rchar = ']' THEN
  148.         DO
  149.             rnest = rnest - 1
  150.             IF rnest = -1 THEN rpos = rcp
  151.         END
  152.         rcp = rcp + 1
  153.     END
  154.     
  155. /*
  156. If we have both lnest and rnest =-1, we have found a valid [] pair,
  157. and need to check it out further, so we set the found flag.  If,
  158. on the other hand, we have reached both ends of the formula string
  159. without finding a [] pair, we just exit without setting the found flag.
  160. */
  161.  
  162.     IF (lnest=-1)&(rnest=-1) THEN
  163.     DO
  164.         leave=1
  165.         found=1
  166.     END
  167.     IF (lcp=0)&(rcp=fml_len+1) THEN leave=1
  168. END
  169.  
  170. /*
  171. We've found a control code, so strip it out!
  172. */
  173.  
  174. IF found=1 THEN
  175. DO
  176.     strip_left=0
  177.     strip_right=0
  178.     lc1=''
  179.     lc2.=''
  180.     lc3.=''
  181.     lc5=''
  182.     rc2=''
  183.     rc3.=''
  184.     rc4=''
  185.     
  186. /*
  187. Grab a series of substrings from the formula string, to be checked
  188. against the codes the program can safely remove.
  189. */
  190.  
  191.     IF lpos > 1 THEN lc1=SUBSTR(fml,lpos-1,1,' ')
  192.     IF lpos > 2 THEN lc2.1=SUBSTR(fml,lpos-2,2,' ')
  193.     IF lpos > 3 THEN lc2.2=SUBSTR(fml,lpos-3,2,' ')
  194.     IF lpos > 3 THEN lc3.1=SUBSTR(fml,lpos-3,3,' ')
  195.     IF lpos > 4 THEN lc3.2=SUBSTR(fml,lpos-4,3,' ')
  196.     IF lpos > 4 THEN lc4=SUBSTR(fml,lpos-4,4,' ')
  197.     IF lpos > 5 THEN lc5=SUBSTR(fml,lpos-5,5,' ')
  198.     IF lpos > 7 THEN lc7=SUBSTR(fml,lpos-7,7,' ')
  199.     IF rpos < fml_len-1 THEN rc2=SUBSTR(fml,rpos+1,2,' ')
  200.     IF rpos < fml_len-2 THEN rc3.1=SUBSTR(fml,rpos+1,3,' ')
  201.     IF rpos < fml_len-6 THEN rc3.2=SUBSTR(fml,rpos+4,3,' ')
  202.     IF rpos < fml_len-6 THEN rc4=SUBSTR(fml,rpos+4,4,' ')
  203.     
  204. /*
  205. Compare the grabbed strings to the removable formula codes
  206. */
  207.  
  208.     IF (lc1 = '^')|(lc1 = '_')&~(lc2.1 = '^_') THEN strip_left=1
  209.     IF (lc3.1 = '\ul')|(lc3.1 = '\ol')|(lc2.2 = '\l') THEN strip_left=3
  210.     IF lc3.2 = '\dt' THEN strip_left=4
  211.     IF lc4 = '\not' THEN strip_left=4
  212.     IF (lc5 = '\sqrt')|(lc5 = '\ahat')|(lc5 = '\lvec')|(lc5 = '\rvec')|(lc5 = '\bvec') THEN strip_left=5
  213.     IF (lc7 = '\atilde')|(lc7 = '\aacute')|(lc7 = '\agrave')|(lc7 = '\abreve')|(lc7 = '\acheck') THEN strip_left=7
  214.     
  215.     IF rc2 = '\r' THEN strip_right=3
  216.     
  217. /*
  218. For the \up code, both \up[\sy<x>] and \up\sy<x> are valid.  The first
  219. form is found in pre MS3 formulae, whereas the second is the form
  220. inserted by MS3
  221. */
  222.  
  223.     IF (rc3.1 = '\up')&(rc3.2 = '\sy') THEN strip_right=7
  224.     IF (rc3.1 = '\up')&(rc4 = '[\sy') THEN strip_right=9
  225.     
  226. /*
  227. If we have found a removable code, then remove it...
  228. */
  229.  
  230.     IF (strip_left > 0)|(strip_right > 0) THEN
  231.     DO
  232.         lleft = lpos-strip_left-1
  233.         lcentre = rpos-lpos-1
  234.         pcentre = lpos+1
  235.         lright = fml_len-rpos-strip_right
  236.         fml = LEFT(fml,lleft)||SUBSTR(fml,pcentre,lcentre)||RIGHT(fml,lright)
  237.     END
  238.  
  239. /*
  240. Deal with the special case of \rt[][]
  241. */
  242.  
  243.     IF lc3.1 = '\rt' THEN
  244.     DO
  245.         lleft = lpos-4
  246.         lcentre = rpos-lpos-1
  247.         pcentre = lpos+1
  248.         lright = fml_len-rpos
  249.         fml = LEFT(fml,lleft)||SUBSTR(fml,pcentre,lcentre)||RIGHT(fml,lright)
  250.         fml = INSERT('\sqrt',fml,lleft+1)
  251.     END
  252. END
  253. RETURN fml
  254.